home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #11 (Aug 86) / pascal / RegMDEF Source / RegMDEF.Pas < prev    next >
Pascal/Delphi Source File  |  1986-05-10  |  16KB  |  487 lines
  1. {###############################################################################}
  2. {#                                           #}
  3. {#                RegMDEF.Pas                       #}
  4. {#                ------------                       #}
  5. {#                                           #}
  6. {#             (Regular Menu Definition Routine Example)               #}
  7. {#              ( just like apples, except in pascal )               #}
  8. {#                                           #}
  9. {#    This was written by Darryl Lovato.                       #}
  10. {#                                           #}
  11. {#    Copyright (c) 1986 by TML Systems.                       #}
  12. {#                                           #}
  13. {###############################################################################}
  14.  
  15. program RegMDEF;
  16.  
  17. {----------------------------- Compiler Directives -----------------------------}
  18.  
  19.   {$B+            }    { Tell the linker to set the bundle bit        }
  20.   {$T APPL RMDF        }    { Set type to Application and creator to RMDF    }
  21.   {$I MemTypes.ipas    }    { Include the Memory Declarations        }
  22.   {$I QuickDraw.ipas    }    { Include the QuickDraw Declarations        }
  23.   {$I OSIntf.ipas    }    { Include the Operating System Declarations    }
  24.   {$I ToolIntf.ipas    }    { Include the Toolbox Declarations        }
  25.   {$L RegMDEFRsrc    }    { Tell the linker to link the resources        }
  26.   {$U RegMDEFGlue    }    { link our assembly code in too...        }
  27.  
  28. {------------------------------- Global Constants ------------------------------}
  29.  
  30.   const
  31.     appleMenu = 300;        { Resource ID of the Apple menu            }
  32.  
  33.     fileMenu = 301;        { Resource ID of the File menu            }
  34.  
  35.     editMenu = 302;        { Resource ID of the Edit menu            }    
  36.     
  37.     beginMenu = 300;        { Res ID of first menu in menu bar        }
  38.     endMenu = 302;        { Res ID of last menu in menu bar        }
  39.  
  40.     RegMenu = 500;        { Res ID of our regular menu        }
  41.  
  42. {------------------------------- Global Variables ------------------------------}
  43.  
  44.   var
  45.     myMenus : array[beginMenu..endMenu] of MenuHandle; { The menus in menu bar    }
  46.     Finished : Boolean;                { Set to true when were done    }
  47.     screenPort : GrafPtr;            { the window mngr port        }
  48.     MyRegMenu : MenuHandle;            { my regular menu handle    }
  49.  
  50. {----------------------------- Assembly Procedures -----------------------------}
  51.  
  52. procedure GetItemKey(theMenu : MenuHandle;
  53.             theItem : Integer;
  54.             var theChar : Char); external;
  55.  
  56. {--------------------------- ChkOnOffItem procedure ----------------------------}
  57.  
  58. procedure ChkOnOffItem(MenuHdl:MenuHandle; item, first, last:Integer);
  59. var
  60.   i: integer;
  61. begin
  62.   for i := first to last do
  63.     begin
  64.       if item = i then
  65.         CheckItem(MenuHdl, i, true) {check it on in menu}
  66.       else
  67.         CheckItem(MenuHdl, i, false); {check it off in menu}
  68.     end;
  69. end;
  70.     
  71. {----------------------------- MenuDef Procedure -------------------------------}
  72.  
  73. procedure MyMenuDef(message : Integer;        { what are we supposed to do?}
  74.         theMenu : MenuHandle;        { what menu ?}
  75.         var menuRect : Rect;        { in what rect?}
  76.         hitPt : Point;            { where's the mouse?}
  77.         var whichItem : Integer);    { what item is that?}
  78.  
  79. {--------------------------- semi-global constants -----------------------------}
  80.  
  81.   const
  82.     MBarHeight = 20;
  83.  
  84. {----------------------------- DimRect procedure -------------------------------}
  85.  
  86.   procedure DimRect(theRect : Rect);
  87.     begin
  88.       PenPat(gray);
  89.       PenMode(patBic);
  90.       PaintRect(theRect);
  91.       PenNormal;
  92.     end;
  93.  
  94. {--------------------------- GetItemsRect Function -----------------------------}
  95.  
  96.    function GetItemsRect(myMenu : MenuHandle;
  97.               myRect : Rect;
  98.               theItem : Integer) : Rect;
  99.     var
  100.       Index : Integer;
  101.       currentRect : Rect;
  102.       itemIcon : Byte;
  103.     begin
  104.       currentRect.bottom := myRect.top; { initialize the current rect}
  105.       currentRect.left := myRect.left;
  106.       currentRect.right := myRect.right;
  107.       for index := 1 to theItem do
  108.     begin
  109.       GetItemIcon(myMenu,index,itemIcon);
  110.  
  111.       currentRect.top := currentRect.bottom; { update the rect }
  112.       if itemIcon <> 0 then
  113.         currentRect.bottom := currentRect.top + 36
  114.       else 
  115.         currentRect.bottom := currentRect.top + 16;
  116.     end;
  117.       GetItemsRect := currentRect; { return result}
  118.     end;
  119.  
  120. {--------------------------- DoDrawMessage Procedure ---------------------------}
  121.  
  122.   procedure DoDrawMessage(myMenu : MenuHandle;
  123.               myRect : Rect);
  124.     const
  125.       MBarHeight = 20;
  126.     var
  127.       currentItem : Integer;
  128.       currentRect : Rect;
  129.       itemString : str255;
  130.       itemIcon : Byte;
  131.       itemMark : Char;
  132.       itemStyle : Style;
  133.       itemKey : Char;
  134.       thePoint : Point;
  135.       theIcon : Handle;
  136.       iconRect : Rect;
  137.       NewVert : Integer;
  138.  
  139.     begin
  140.       currentRect.bottom := myRect.top; { initialize the current rect}
  141.       currentRect.left := myRect.left;
  142.       currentRect.right := myRect.right;
  143.       for currentItem := 1 to CountMItems(myMenu) do { draw every item}
  144.         begin
  145.       GetItem(myMenu,currentItem,itemString);{ get info on each item}
  146.       GetItemIcon(myMenu,currentItem,itemIcon);
  147.       GetItemMark(myMenu,currentItem,itemMark);
  148.       GetItemStyle(myMenu,currentItem,itemStyle);
  149.       GetItemKey(myMenu,currentItem,itemKey);
  150.  
  151.       currentRect.top := currentRect.bottom; { update the rect }
  152.       if itemIcon <> 0 then
  153.         currentRect.bottom := currentRect.top + 36
  154.       else 
  155.         currentRect.bottom := currentRect.top + 16;
  156.       
  157.       if itemString = '-' then { special case '-' item}
  158.         begin
  159.           PenPat(Gray);
  160.           moveTo(currentRect.left,currentRect.top + 8);
  161.           Line(currentRect.right,0);
  162.           PenPat(Black);
  163.         end
  164.       else { draw the other item stuff}
  165.         begin              {get baseline}
  166.           NewVert := ((currentRect.bottom - currentRect.top) DIV 2);
  167.           NewVert := currentRect.top + 4 + NewVert; 
  168.           MoveTo(currentRect.left + 2,newVert);
  169.           
  170.           if itemMark <> Chr(0) then
  171.             DrawChar(itemMark);
  172.           
  173.           if itemIcon <> 0 then { draw the icon}
  174.             begin
  175.           iconRect.top := currentRect.top + 2;
  176.           iconRect.bottom := iconRect.top + 32;
  177.           iconRect.left := currentRect.left + 13;
  178.           iconRect.right := iconRect.left + 32;
  179.           theIcon := GetIcon(256 + itemIcon);
  180.           PlotIcon(iconRect,theIcon);
  181.           GetPen(thePoint);
  182.               MoveTo(currentRect.left + 47,thePoint.v); { move over a bit}
  183.         end
  184.           else { otherwise, just move over a bit}
  185.             begin
  186.           GetPen(thePoint);
  187.               MoveTo(currentRect.left + 13,thePoint.v); 
  188.         end;
  189.  
  190.          TextFace(itemStyle);
  191.          DrawString(itemString);
  192.          TextFace([]);
  193.          
  194.          if itemKey <> Chr(0) then { draw key equiv}
  195.            begin
  196.              GetPen(thePoint);
  197.              MoveTo(currentRect.right - 24,thePoint.v);{ move over a bit}
  198.          DrawChar(Chr($11)); { draw cmd char symbol}
  199.          DrawChar(itemKey); { and the cmd key}
  200.            end;
  201.     
  202.          if (BitAnd(myMenu^^.enableFlags,1) = 0) then {menu id disabled!}
  203.            DimRect(currentRect);
  204.          if (BitAnd(BitShift(myMenu^^.enableFlags,-currentItem),1) = 0) then
  205.            DimRect(currentRect);
  206.     
  207.        end; { of if itemString = '-' then..else..}
  208.     end;
  209.     end; { of DoDrawMessage}
  210.  
  211. {-------------------------- DoChooseMessage Procedure --------------------------}
  212.   
  213.   function DoChooseMessage(myMenu : MenuHandle;
  214.               myRect : Rect;
  215.             myPoint : Point;
  216.             oldItem : Integer) : Integer;
  217.     var
  218.       theItem : Integer;
  219.       ItemsRect : Rect;
  220.     begin
  221.       if PtInRect(myPoint,myRect) then
  222.         begin
  223.       theItem := 1;
  224.       repeat
  225.         ItemsRect := GetItemsRect(myMenu, myRect,theItem);
  226.         theItem := theItem + 1;
  227.       until PtInRect(myPoint,itemsRect);
  228.       theItem := theItem - 1; { undo last increment}
  229.  
  230.       if (BitAnd(myMenu^^.enableFlags,1) = 0) or 
  231.         (BitAnd(BitShift(myMenu^^.enableFlags,-theItem),1) = 0) then
  232.           begin
  233.             theItem := 0;
  234.           end;
  235.  
  236.       if theItem <> oldItem then {de-select old, select new}
  237.         begin
  238.           if oldItem <> 0 then { deselect old}
  239.         InvertRect(GetItemsRect(myMenu, myRect,oldItem));
  240.           if theItem <> 0 then
  241.             InvertRect(GetItemsRect(myMenu, myRect,theItem));
  242.         end;
  243.       DoChooseMessage := theItem; { return result}
  244.     end
  245.       else { it was not in our menu}
  246.         begin
  247.       if oldItem <> 0 then { we need to de-select old item}
  248.         InvertRect(GetItemsRect(myMenu, myRect,oldItem));
  249.           DoChooseMessage := 0; { return result}
  250.     end;
  251.     end;
  252.  
  253. {--------------------------- DoSizeMessage Procedure ---------------------------}
  254.  
  255.   procedure DoSizeMessage(var myMenu : MenuHandle);
  256.     var
  257.       MaxWidth : integer;    { keep track of the maximum width}
  258.       TotalHeight : integer;    { keep track of the total height}
  259.       currentItem : integer;    { the menu item we are currently looking at}
  260.       itemString : Str255;    { text of the curren menu item}
  261.       itemIcon : Byte;        { resource id of the menu items icon}
  262.       itemMark : char;        { the items mark}
  263.       itemStyle : Style;    { the items character style}
  264.       itemKey : Char;        { the keyboard equiv}
  265.       tempWidth : Integer;    { the current items width}
  266.       
  267.     begin
  268.       MaxWidth := 0;        { initailize width}
  269.       TotalHeight := 0;        { initialize height}
  270.       for currentItem := 1 to CountMItems(myMenu) do { look at every item}
  271.     begin
  272.       GetItem(myMenu,currentItem,itemString); { get the items text}
  273.       GetItemIcon(myMenu,currentItem,itemIcon); { get the items icon}
  274.       GetItemMark(myMenu,currentItem,itemMark); { get the items marked char}
  275.       GetItemStyle(myMenu,currentItem,itemStyle); { get the items style}
  276.       GetItemKey(myMenu,currentItem,itemKey); { get the items key}
  277.       
  278.       tempWidth := 13; { indent a bit}
  279.       if itemIcon <> 0 then
  280.         tempWidth := tempWidth + 35; { make room for items icon}
  281.       TextFace(itemStyle); { set to items style}
  282.       tempWidth := tempWidth + StringWidth(itemString) + 4;
  283.       TextFace([]); {return to normal}
  284.       if itemKey <> Chr(0) then
  285.         tempWidth := tempWidth + 30;
  286.  
  287.       if tempWidth > MaxWidth then
  288.         MaxWidth := tempWidth;
  289.       if itemKey <> chr(0) then
  290.         tempWidth := tempWidth + 20;
  291.       
  292.       if itemIcon <> 0 then
  293.         TotalHeight := totalHeight + 36 { add lots of space}
  294.       else
  295.         TotalHeight := totalHeight + 16; { add just enough for text}
  296.  
  297.     end;
  298.       with myMenu^^ do
  299.         begin
  300.       menuWidth := MaxWidth;    { save result in menu record}
  301.       menuHeight := TotalHeight;    { ditto...}
  302.     end;
  303.     end;
  304.  
  305. {--------------------- Case on message and call procedure ----------------------}
  306.  
  307. begin
  308.   case message of
  309.     mSizeMsg :
  310.       begin
  311.         DoSizeMessage(theMenu);
  312.       end;
  313.     mDrawMsg : 
  314.       begin
  315.         DoDrawMessage(theMenu,menuRect);
  316.       end;
  317.     mChooseMsg :
  318.       begin
  319.         whichItem := DoChooseMessage(theMenu,menuRect,hitPt,whichItem);
  320.       end;
  321.   end;
  322. end;
  323.  
  324. {------------------------- process the menu selection --------------------------}
  325.  
  326.   procedure ProcessMenu(CodeWord : LongInt);
  327.  
  328.     var
  329.       menuNum : Integer;            { Res ID of the menu Selected    }
  330.       itemNum : Integer;            { The item number selected    }
  331.       nameHolder : str255;            { the name of the desk acc.    }
  332.       dummy : Integer;                { just a dummy            }
  333.       AboutRecord : DialogRecord;        { the actual object        }
  334.       AboutDlog : DialogPtr;            { a pointer to my dialog    }
  335.  
  336.     begin
  337.       menuNum := HiWord(CodeWord);        { get the menu number        }
  338.       itemNum := LoWord(CodeWord);        { get the item number        }
  339.       if itemNum > 0 then            { ok to handle the menu?    }
  340.         begin
  341.       case MenuNum of
  342.         appleMenu :
  343.           begin
  344.             case ItemNum of
  345.           1:
  346.             begin
  347.               AboutDlog := GetNewDialog(3000,@AboutRecord,Pointer(-1));
  348.               ModalDialog(nil,dummy);
  349.               CloseDialog(AboutDlog);
  350.             end;
  351.           2:begin
  352.             end;
  353.           otherwise
  354.             begin
  355.               GetItem(myMenus[appleMenu],ItemNum,NameHolder);
  356.               dummy := OpenDeskAcc(NameHolder);
  357.             end;
  358.         end;
  359.           end;
  360.         fileMenu :
  361.           begin
  362.             Finished := true;
  363.           end;
  364.         editMenu :
  365.           begin
  366.             if not SystemEdit(ItemNum - 1) then
  367.           begin
  368.             {we dont support any other editing}
  369.           end;
  370.           end;
  371.         RegMenu : 
  372.           begin
  373.             if ItemNum <> 0 then
  374.           begin
  375.             if itemNum > 3 then
  376.               ChkOnOffItem(MyRegMenu, ItemNum, 4, 9);
  377.           end;
  378.           end;
  379.       end;                    { of case menuNum of        }
  380.     end;                    { of if CodeWord...        }
  381.       HiliteMenu(0);
  382.     end;                    { of process menu        }
  383.  
  384. {------------------------------- Main Event loop -------------------------------}
  385.  
  386.   procedure MainEventLoop;
  387.  
  388.     type
  389.       trickType = packed record            { to get around pascal's typing    }
  390.         case boolean of
  391.       true :
  392.         (I : LongInt);
  393.       false :
  394.         (chr3, chr2, chr1, chr0 : Char);
  395.     end;
  396.  
  397.     var
  398.       Event : EventRecord;            { Filled by Get next event    }
  399.       windowLoc : integer;            { the mouse location        }
  400.       mouseLoc : point;                { the area it was in        }
  401.       theWindow : WindowPtr;            { Dummy,cause we have no windows}
  402.       trickVar : trickType;            { because of pascal's typing    }
  403.       CharCode : Char;                { for command keys        }
  404.     begin
  405.       repeat                    { do this until we selected quit}
  406.     SystemTask;                { Take care of desk accessories    }
  407.     if GetNextEvent(everyEvent,Event) then    { if there was an event... then    }
  408.       begin
  409.         case event.what of            { case out on the event type    }
  410.           mouseDown :            { we had a mouse-down event    }
  411.         begin
  412.           mouseLoc := Event.where;    { wheres the pesky mouse    }
  413.           windowLoc := FindWindow(mouseLoc,theWindow); { find out where }
  414.           case windowLoc of        { now case on the location    }
  415.             inMenuBar :
  416.               ProcessMenu(MenuSelect(MouseLoc)); { Handle the selection    }
  417.             inSysWindow:
  418.               SystemClick(Event,theWindow); {It was in a desk acc    }
  419.           end;
  420.         end;
  421.           keyDown,AutoKey :            { we had the user hit a key    }
  422.             begin
  423.           trickVar.I := Event.Message;    { fill the longWord        }
  424.           CharCode := trickVar.chr0;    { and pull off the low-byte    }
  425.           if BitAnd(Event.modifiers,CmdKey) = CmdKey then { if cmd down    }
  426.             ProcessMenu(MenuKey(CharCode));
  427.         end;
  428.         end;                { of case event.what...        }
  429.       end;                    { end of if Get Next event    }
  430.       until(Finished);                { end of repeat statement    }
  431.     end;                    { of main event loop        }
  432.  
  433. {------------------------------ SetUp Everything -------------------------------}
  434.  
  435.   procedure SetUpThings;
  436.  
  437.     type
  438.       ProcHdl = ^ProcPtr;
  439.  
  440.     var
  441.       index : integer;                { used in a for loop        }
  442.      
  443.     begin
  444.       for index := beginMenu to endMenu do    { Loop for all menus in menu bar}
  445.         begin
  446.       myMenus[index] := GetMenu(index);    { Get the next menu        }
  447.     end;
  448.       AddResMenu(myMenus[appleMenu],'DRVR');    { Add desk accessories        }
  449.       for index := beginMenu to endMenu do    { loop for all menus in menu bar}
  450.     InsertMenu(myMenus[index],0);        { Insert the menu        }
  451.  
  452. { here is the non-standard menu }
  453.  
  454.       MyRegMenu := GetMenu(500);        { make a new Menu        }
  455.       MyRegMenu^^.menuProc := NewHandle(0);    { get a new Master Pointer    }
  456.       MyRegMenu^^.menuProc^ := Ptr(@MyMenuDef);    { get hdl to routine        }
  457.       Insertmenu(MyRegMenu,0);            { and add it to the menu list    }
  458.       CalcMenuSize(MyRegMenu);            { and calculate its size,NEEDED!}
  459.       DrawMenuBar;                { Now draw the menu bar            }
  460.       ChkOnOffItem(MyRegMenu, 4, 4, 9);        { check an item in the menu    }
  461.     end;
  462.  
  463. {---------------------------- Initialize Everything ----------------------------}
  464.  
  465.   procedure InitThings;
  466.     begin
  467.       InitGraf(@thePort);            { create grafPort for the screen}
  468.       MoreMasters;                { create a bunch of master Ptr's}
  469.       MoreMasters;                { so we wont need to worry about}
  470.       MoreMasters;                { heap fragmentation later!    }
  471.       MaxApplZone;                { make sure we have lots of mem }
  472.       InitFonts;                { Startup the Font manager    }
  473.       InitWindows;                { Startup the Window manager    }
  474.       InitMenus;                { Startup the Menu manager    }
  475.       TEInit;                    { initialize text edit        }
  476.       InitDialogs(nil);                { initialize dialogs        }
  477.       InitCursor;                { make the cursor an arrow    }
  478.     end;
  479.  
  480. {------------------------------- Main Program Seg ------------------------------}
  481.  
  482. begin
  483.   InitThings;
  484.   SetUpThings;
  485.   Finished := false;
  486.   MainEventLoop;
  487. end.